Cognitive Psychology Seminar - Inhibition
David I., L. V., L. P., S. R
2018-03-30
Read in data files
data_path <- "./Daten/"
files <- list.files(data_path)
data <- list()
for(f in files){
data[[f]] <- read.table(paste0(data_path,f), stringsAsFactors = FALSE,header=TRUE)
if(f=="StopSignal_1802_bed1_vp13.txt"){
data[[f]]$vp <- 13
}
}
inhib <- bind_rows(data)inhibfilter(inhib, stop == 1)1 Participants
demo <- inhib %>% dplyr::select(.,vp,alt,ges,std) %>% group_by(.,vp) %>%
summarise(age = mean(alt, na.rm = T),
gender = mean(ges, na.rm = T),
std = mean(std, na.rm = T)) %>%
mutate(., gender.f = factor(gender,label=c("male","female","NA"),levels=c(1,2,9)),
std.f = factor(std,label=c("psychology","erziehungswiss","lehramt","other","NA"),
levels = c(1,2,3,4,9)))1.0.1 Gender
table(demo$gender.f)##
## male female NA
## 10 11 1 table(demo$gender.f)/nrow(demo)##
## male female NA
## 0.45454545 0.50000000 0.045454551.0.2 Age
psych::describe(demo$age) %>% knitr::kable(.)| vars | n | mean | sd | median | trimmed | mad | min | max | range | skew | kurtosis | se | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| X1 | 1 | 22 | 26.5 | 4.317737 | 26 | 26.44444 | 4.4478 | 19 | 34 | 15 | 0.2456393 | -0.9840568 | 0.9205447 |
hist(demo$age)
1.0.3 Course of Study
table(demo$std.f)##
## psychology erziehungswiss lehramt other NA
## 7 0 9 6 0 table(demo$std.f)/nrow(demo)##
## psychology erziehungswiss lehramt other NA
## 0.3181818 0.0000000 0.4090909 0.2727273 0.00000002 Experiment
2.1 Variable Label and Values
| Variable | Description | Values & Labels |
|---|---|---|
| vp | VPN ID | Nominal 1-22 |
| alt | Age | Integer |
| ges | Gender | Nominal 1 = male; 2=female |
| std | Field of Study | Nominal 1 = psychology; 2 = erziehungsw.; 3 = Lehramt; 4 = other |
| block | Block Number | Nominal 1 = instruction; 2 & 3 = training; 4-6 = testing |
| trg | Overall trial number | Integer |
| trial | Trial number | Integer |
| stnr | ? | Integer |
| stim | stimulus show in trial | Nominal - even = Dogs, odd = Donuts, 01 = blue square, 02 = orange square |
| sneu | ?? | ? |
| kat | Category of stimulus | Nominal 0 = square, 1 = donut, 2 = dog |
| stop | Stop-trial or not | Nominal 0 = no, 1 = yes |
| ssd | Stop-signal delay | Integer 0,100,200 ms |
| rgf | response | Nominal 120 = left,right or nothing; Squares 1 = left, 2 = right ; DD 3 = left, 4 = right |
| resp | given response | Nominal 0 = nothing; Squares: 1 = left, 2 = right ; DD: 3 = left, 4 = right |
| fehl | error | Nominal 0 = no, 1 = yes |
| eff | effect sound | Nominal 0 = high/no-response sound, 12 = deep/response sound |
| krit | Critical trial or not | Nominal 0 = no, 1 = yes |
| feed | Wrong or right feedback | Nominal 0 = no feedback, 1 = right feedback, 2 = wrong feedback |
| rt | reaction time | Integer |
| verp | misses | Integer |
| iti | true inter trial interval | Integer ~ 1100 ms |
| ssd | true Stop-signal delay | Integer ~ 0,100,200 ms |
| datum | date | string |
2.2 Trial informations
Next, I create three new variables, lag_crit, lag_error and lag_feed, where the entries of the krit,fehl and feed variables are shifted by one row, so I have the indication of the feedback type, if it is a critical trial and if the trial before was wrong, in the same row as the actual trial. At the end, I transform the feedback and block variables into factors.
inhib <- inhib %>% dplyr::select(.,-trg,-trial,-stnr,-sneu, -iti,-datum) %>%
mutate(., lag_crit = lag(krit) + 0,
lag_feed = lag(feed) + 0,
lag_error= lag(fehl) + 0,
lag_stop = lag(stop) + 0) %>%
dplyr::select(.,vp,alt,std,ges,block,rgf,res,stop,kat,krit,ssd,
fehl,lag_feed,lag_crit,lag_error,lag_stop,rt) %>%
mutate(.,feed.f=factor(lag_feed,levels=c(0,1,2),
labels=c("normal","right feedback","wrong feedback")),
block.f=factor(block))
inhib %>% group_by(vp,block.f) %>% summarise(., trials = length(res),
squareTrials = sum(kat==0),
catTrials = sum(kat!=0),
criticaltrials = sum(krit==1),
lagcriticaltrials = sum(lag_crit==1),
errors = sum(fehl==1),
stopTrial = sum(stop==1),
critStop = sum(stop==1 & krit==1),
noncritStop = sum(stop==1 & krit==0)
) We want to exclude those trials, where the critical square trial and the categorization trial fall into different blocks. Number of trials now: 14700.
inhib <- inhib %>% mutate(., lag_crit_block = lag(block)) %>% filter(., !(lag_crit==1 & block!=lag_crit_block))New number of trials: 14685.
2.2.1 How many stop trials are also critical trials?
test <- filter(inhib, block == 4 | block == 5 | block == 6)
table("stop"=test$stop,"krit"=test$krit)## krit
## stop 0 1
## 0 7646 0
## 1 264 1319Every critical trial is a stop trial.
2.2.2 Error Rates
I will only include the blocks 4,5 and 6.
Error rates for each participant:
(errorRates <- inhib %>% filter(., block == 4 | block == 5 | block == 6) %>% group_by(vp) %>%
summarise(., Ntrials = length(res),
Nerrors = sum(fehl==1),
ErrorTrials = Nerrors/Ntrials,
Ncrit = sum(lag_crit==1),
ErrorCrit = sum(lag_crit==1 & lag_error==1)/Ncrit,
Nsquare = sum(kat==0),
ErrorSquare = sum(kat==0 & fehl==1)/Nsquare,
Nstop = sum(stop==1),
Nstop100 = sum(stop==1 & ssd==100),
Nstop200 = sum(stop==1 & ssd==200),
ErrorStop = sum(stop==1 & fehl==1)/Nstop,
ErrorStop100 = sum(stop==1 & fehl==1 & ssd==100)/sum(stop==1& ssd==100),
ErrorStop200 = sum(stop==1 & fehl==1 & ssd==200)/sum(stop==1& ssd==200),
Ncat = sum(kat!=0),
ErrorCat = sum(kat!=0 & fehl==1)/Ncat,
## RTs
meanRT = mean(rt),
medianRT = median(rt),
diffMeanMedian = meanRT-medianRT) %>% round(.,2))Aggregated over all participants:
describe(errorRates) %>% as.data.frame() %>% select(.,mean,sd,median,min,max) %>% round(.,2) %>% knitr::kable(.)| mean | sd | median | min | max | |
|---|---|---|---|---|---|
| vp | 11.50 | 6.49 | 11.50 | 1.00 | 22.00 |
| Ntrials | 419.50 | 0.51 | 419.50 | 419.00 | 420.00 |
| Nerrors | 38.82 | 32.46 | 27.50 | 11.00 | 129.00 |
| ErrorTrials | 0.09 | 0.08 | 0.06 | 0.03 | 0.31 |
| Ncrit | 59.36 | 0.66 | 59.00 | 58.00 | 60.00 |
| ErrorCrit | 0.07 | 0.05 | 0.07 | 0.00 | 0.17 |
| Nsquare | 239.73 | 0.46 | 240.00 | 239.00 | 240.00 |
| ErrorSquare | 0.12 | 0.10 | 0.10 | 0.04 | 0.52 |
| Nstop | 71.95 | 0.21 | 72.00 | 71.00 | 72.00 |
| Nstop100 | 47.95 | 0.21 | 48.00 | 47.00 | 48.00 |
| Nstop200 | 24.00 | 0.00 | 24.00 | 24.00 | 24.00 |
| ErrorStop | 0.10 | 0.05 | 0.10 | 0.01 | 0.21 |
| ErrorStop100 | 0.03 | 0.03 | 0.02 | 0.00 | 0.10 |
| ErrorStop200 | 0.24 | 0.10 | 0.25 | 0.04 | 0.42 |
| Ncat | 179.77 | 0.43 | 180.00 | 179.00 | 180.00 |
| ErrorCat | 0.06 | 0.12 | 0.02 | 0.00 | 0.55 |
| meanRT | 490.48 | 26.43 | 492.81 | 436.81 | 548.87 |
| medianRT | 553.26 | 37.85 | 546.62 | 499.94 | 636.82 |
| diffMeanMedian | -62.78 | 18.08 | -65.35 | -98.31 | -17.65 |
2.2.3 Exclusion of VPN with error rates > 15 %
filter_vp <- filter(errorRates,ErrorTrials > 0.15) %>% select(.,vp)
inhib <- inhib[!(inhib$vp %in% filter_vp$vp),]2.2.3.1 Updated Error Rates
errorRates <- inhib %>% filter(., block == 4 | block == 5 | block == 6) %>% group_by(vp) %>%
summarise(., Ntrials = length(res),
Nerrors = sum(fehl==1),
ErrorTrials = Nerrors/Ntrials,
Ncrit = sum(lag_crit==1),
ErrorCrit = sum(lag_crit==1 & lag_error==1)/Ncrit,
Nsquare = sum(kat==0),
ErrorSquare = sum(kat==0 & fehl==1)/Nsquare,
Nstop = sum(stop==1),
Nstop100 = sum(stop==1 & ssd==100),
Nstop200 = sum(stop==1 & ssd==200),
ErrorStop = sum(stop==1 & fehl==1)/Nstop,
ErrorStop100 = sum(stop==1 & fehl==1 & ssd==100)/sum(stop==1& ssd==100),
ErrorStop200 = sum(stop==1 & fehl==1 & ssd==200)/sum(stop==1& ssd==200),
Ncat = sum(kat!=0),
ErrorCat = sum(kat!=0 & fehl==1)/Ncat,
## RTs
meanRT = mean(rt),
medianRT = median(rt),
diffMeanMedian = meanRT-medianRT)
describe(errorRates) %>% as.data.frame() %>% select(.,mean,sd,median,min,max) %>% round(.,2) %>% knitr::kable(.)| mean | sd | median | min | max | |
|---|---|---|---|---|---|
| vp | 11.25 | 6.65 | 11.50 | 1.00 | 22.00 |
| Ntrials | 419.55 | 0.51 | 420.00 | 419.00 | 420.00 |
| Nerrors | 29.85 | 15.28 | 25.00 | 11.00 | 63.00 |
| ErrorTrials | 0.07 | 0.04 | 0.06 | 0.03 | 0.15 |
| Ncrit | 59.40 | 0.68 | 59.50 | 58.00 | 60.00 |
| ErrorCrit | 0.07 | 0.05 | 0.06 | 0.00 | 0.17 |
| Nsquare | 239.80 | 0.41 | 240.00 | 239.00 | 240.00 |
| ErrorSquare | 0.10 | 0.04 | 0.09 | 0.04 | 0.20 |
| Nstop | 71.95 | 0.22 | 72.00 | 71.00 | 72.00 |
| Nstop100 | 47.95 | 0.22 | 48.00 | 47.00 | 48.00 |
| Nstop200 | 24.00 | 0.00 | 24.00 | 24.00 | 24.00 |
| ErrorStop | 0.10 | 0.05 | 0.09 | 0.01 | 0.21 |
| ErrorStop100 | 0.03 | 0.03 | 0.02 | 0.00 | 0.10 |
| ErrorStop200 | 0.24 | 0.10 | 0.25 | 0.04 | 0.42 |
| Ncat | 179.75 | 0.44 | 180.00 | 179.00 | 180.00 |
| ErrorCat | 0.04 | 0.04 | 0.02 | 0.00 | 0.17 |
| meanRT | 489.47 | 27.26 | 492.81 | 436.81 | 548.87 |
| medianRT | 551.12 | 38.57 | 538.98 | 499.94 | 636.82 |
| diffMeanMedian | -61.66 | 18.47 | -64.13 | -98.31 | -17.65 |
2.2.4 Plot Error Distributions
errorRates %>% select(., starts_with("Error")) %>% gather() %>% dplyr::rename(.,Errors=key) %>%
ggplot(., aes(x=value*100, fill=Errors)) +
geom_density(col=NA,alpha=0.5) +
geom_rug(aes( y = 0,colour=Errors), position = position_jitter(height = 0),size = 1, show.legend = FALSE) +
xlim(c(0,50)) +
ggtitle("Distributions of Error Rates Accros Participants") +
theme_bw() +
labs(
#title = "Hitrate",
x = " % Error Rate",
y = "Frequency",
color = NULL
)
# ggsave("ErrorDistributuons.png",dpi=900,width=12,height=6, units = "cm",bg = "transparent")
errorRates %>% select(., starts_with("Error")) %>% gather() %>% dplyr::rename(.,Errors=key) %>%
ggplot(.) +
geom_density(aes(x=value*100)) +
geom_rug(aes(x=value*100,y = 0), position = position_jitter(height = 0),size = 1, show.legend = FALSE) +
ggtitle("Distributions of Error Rates Accros Participants") +
theme_bw() +
labs(
#title = "Hitrate",
x = " % Error Rate",
y = "Frequency",
color = NULL
) + facet_wrap(~Errors)
2.3 Analysis
First, I filter only for those trials in the experimental blocks 4-6 were the stimulus was a dog or a donut
inhib_crit <- filter(inhib, block == 4 | block == 5 | block == 6, kat == 1 | kat == 2)2.3.1 Error Rates (for blocks 4,5 and 6 only)
Here we see the number of critical trials, errors and some RT descriptives per person
inhib_crit %>% group_by(vp) %>% summarise(., trials = length(res),
criticaltrials = sum(lag_crit==1),
errors = sum(fehl==1),
lag_errors = sum(lag_error==1),
errorrate = errors/trials,
meanRT = mean(rt),
medianRT = median(rt),
diffMeanMedian = meanRT-medianRT)and aggregated over all persons.
inhib_crit %>% group_by(vp) %>% summarise(., trials = length(res),
criticaltrials = sum(lag_crit==1),
errors = sum(fehl==1),
lage_errors=sum(lag_error==1),
errorrate = errors/criticaltrials,
meanRT = mean(rt),
medianRT = median(rt),
diffMeanMedian = meanRT-medianRT) %>%
summarise(., meanT = mean(trials),
meanCT = mean(criticaltrials)
)2.3.1.1 Updated Demographics:
demo <- inhib %>% dplyr::select(.,vp,alt,ges,std) %>% group_by(.,vp) %>%
# filter(.,vp !=3 & vp != 6 & vp != 18) %>%
summarise(age = mean(alt, na.rm = T),
gender = mean(ges, na.rm = T),
std = mean(std, na.rm = T)) %>%
mutate(., gender.f = factor(gender,labels=c("male","female","NA"),levels=c(1,2,9)),
std.f = factor(std,labels=c("psychology","erziehungswiss","lehramt","other","NA"),
levels=c(1,2,3,4,9)))
psych::describe(demo$age) %>% knitr::kable()| vars | n | mean | sd | median | trimmed | mad | min | max | range | skew | kurtosis | se | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| X1 | 1 | 20 | 26.2 | 4.348018 | 26 | 26.0625 | 4.4478 | 19 | 34 | 15 | 0.3602901 | -0.8993387 | 0.9722464 |
table(demo$gender.f)##
## male female NA
## 10 9 12.3.1.2 Looking at the errors people made:
filter(inhib_crit,fehl==1)There are a lot of errors where people didn’t press any button and therefore get an reaction time == 0. Therefore, I will exclude all trials with errors. I will also exclude all critical trials were the square trial before was answered wrong, because then the “wrong” feedback isn’t wrong anymore.
inhib_crit_we <- filter(inhib_crit,fehl==0 & lag_error==0)Critical trials, errors and mean & median RT per person:
inhib_crit_we %>% group_by(vp) %>% summarise(., trials = length(res),
criticaltrials = sum(lag_crit==1),
errors = sum(fehl==1),
lage_errors=sum(lag_error==1),
errorrate = errors/criticaltrials,
meanRT = mean(rt),
medianRT = median(rt),
diffMeanMedian = meanRT-medianRT)and over all persons:
inhib_crit_we %>% group_by(vp) %>% summarise(., trials = length(res),
criticaltrials = sum(lag_crit==1),
errors = sum(fehl==1),
lage_errors=sum(lag_error==1),
errorrate = errors/criticaltrials,
meanRT = mean(rt),
medianRT = median(rt),
diffMeanMedian = meanRT-medianRT) %>%
summarise(., meanNumberOfTrials = mean(trials),
meanNumberOfCriticalTrials = mean(criticaltrials),
sd = sd(criticaltrials)
)2.3.2 Within-ANOVA
2.3.2.1 Descriptives
inhib_crit_we %>% group_by(feed.f) %>%
dplyr::summarize(., meanRT = mean(rt),
medianRT = median(rt),
sdRT = sd(rt))inhib_crit_we %>% group_by(feed.f,block.f) %>%
dplyr::summarize(., meanRT = mean(rt),
medianRT = median(rt),
sdRT = sd(rt))plotDF <- inhib_crit_we %>% group_by(vp,feed.f) %>%
dplyr::summarize(., meanRT = mean(rt))
ggplot(plotDF, aes(x=meanRT, fill=feed.f)) +
geom_density(col=NA,alpha=0.4) +
ggtitle("Distributions of RT (ms)")
ggplot(plotDF, aes(y=meanRT, x=feed.f,fill=feed.f)) +
geom_violin(col=NA,alpha=0.4) +
ggtitle("Distributions of RT (ms)")
2.3.2.2 ANOVA
2.3.2.2.1 Aggregated By Mean
mod <- aov_car(rt ~ feed.f + Error(vp/feed.f),data=inhib_crit_we,fun_aggregate = mean)
knitr::kable(nice(mod))| Effect | df | MSE | F | ges | p.value |
|---|---|---|---|---|---|
| feed.f | 1.44, 27.34 | 1067.17 | 11.96 *** | .10 | .0006 |
summary(mod)##
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
##
## SS num Df Error SS den Df F Pr(>F)
## (Intercept) 21280086 1 136190 19 2968.802 < 2.2e-16 ***
## feed.f 18363 2 29180 38 11.957 9.375e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Mauchly Tests for Sphericity
##
## Test statistic p-value
## feed.f 0.61027 0.011742
##
##
## Greenhouse-Geisser and Huynh-Feldt Corrections
## for Departure from Sphericity
##
## GG eps Pr(>F[GG])
## feed.f 0.71957 0.0006034 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## HF eps Pr(>F[HF])
## feed.f 0.7625662 0.0004529147# get the least square means
referenceGrid <- emmeans(mod, ~ feed.f)
# pairwise comparisons
summary(pairs(referenceGrid, adjust="bonferroni")) %>% knitr::kable(.)| contrast | estimate | SE | df | t.ratio | p.value |
|---|---|---|---|---|---|
| normal - right.feedback | -37.2817375 | 8.762967 | 38 | -4.2544651 | 0.0003954 |
| normal - wrong.feedback | -36.9379996 | 8.762967 | 38 | -4.2152389 | 0.0004450 |
| right.feedback - wrong.feedback | 0.3437379 | 8.762967 | 38 | 0.0392262 | 1.0000000 |
# With Block as Factor
mod <- aov_car(rt ~ feed.f + block.f + Error(vp/feed.f+block.f),data=inhib_crit_we,fun_aggregate = mean)
knitr::kable(nice(mod))| Effect | df | MSE | F | ges | p.value |
|---|---|---|---|---|---|
| feed.f | 1.42, 26.97 | 3158.77 | 12.13 *** | .09 | .0006 |
| block.f | 1.83, 34.84 | 1380.68 | 0.16 | .0007 | .84 |
| feed.f:block.f | 3.33, 63.30 | 626.87 | 2.30 + | .008 | .08 |
summary(mod)##
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
##
## SS num Df Error SS den Df F Pr(>F)
## (Intercept) 63849311 1 407622 19 2976.1316 < 2.2e-16 ***
## feed.f 54381 2 85194 38 12.1279 8.442e-05 ***
## block.f 397 2 48105 38 0.1569 0.85534
## feed.f:block.f 4808 4 39682 76 2.3020 0.06619 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Mauchly Tests for Sphericity
##
## Test statistic p-value
## feed.f 0.59107 0.00881
## block.f 0.90934 0.42514
## feed.f:block.f 0.67216 0.64727
##
##
## Greenhouse-Geisser and Huynh-Feldt Corrections
## for Departure from Sphericity
##
## GG eps Pr(>F[GG])
## feed.f 0.70976 0.0005968 ***
## block.f 0.91687 0.8376975
## feed.f:block.f 0.83293 0.0792760 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## HF eps Pr(>F[HF])
## feed.f 0.7505561 0.0004527224
## block.f 1.0099755 0.8553371868
## feed.f:block.f 1.0312881 0.0661895018# get the least square means
referenceGrid <- emmeans(mod, ~ feed.f * block.f)
# pairwise comparisons
summary(pairs(referenceGrid, adjust="bonferroni")) %>% knitr::kable(.)| contrast | estimate | SE | df | t.ratio | p.value |
|---|---|---|---|---|---|
| normal,X4 - right.feedback,X4 | -29.1769840 | 10.466187 | 73.65424 | -2.7877377 | 0.2429542 |
| normal,X4 - wrong.feedback,X4 | -44.7906540 | 10.466187 | 73.65424 | -4.2795580 | 0.0020008 |
| normal,X4 - normal,X5 | -0.7286167 | 8.775322 | 94.42476 | -0.0830302 | 1.0000000 |
| normal,X4 - right.feedback,X5 | -41.1966751 | 11.590240 | 91.22487 | -3.5544283 | 0.0216887 |
| normal,X4 - wrong.feedback,X5 | -26.9123899 | 11.590240 | 91.22487 | -2.3219874 | 0.8085508 |
| normal,X4 - normal,X6 | 5.8502276 | 8.775322 | 94.42476 | 0.6666681 | 1.0000000 |
| normal,X4 - right.feedback,X6 | -34.8329679 | 11.590240 | 91.22487 | -3.0053708 | 0.1233072 |
| normal,X4 - wrong.feedback,X6 | -34.0745772 | 11.590240 | 91.22487 | -2.9399373 | 0.1497179 |
| right.feedback,X4 - wrong.feedback,X4 | -15.6136699 | 10.466187 | 73.65424 | -1.4918203 | 1.0000000 |
| right.feedback,X4 - normal,X5 | 28.4483673 | 11.590240 | 91.22487 | 2.4545107 | 0.5761833 |
| right.feedback,X4 - right.feedback,X5 | -12.0196911 | 8.775322 | 94.42476 | -1.3697151 | 1.0000000 |
| right.feedback,X4 - wrong.feedback,X5 | 2.2645941 | 11.590240 | 91.22487 | 0.1953880 | 1.0000000 |
| right.feedback,X4 - normal,X6 | 35.0272116 | 11.590240 | 91.22487 | 3.0221301 | 0.1172737 |
| right.feedback,X4 - right.feedback,X6 | -5.6559838 | 8.775322 | 94.42476 | -0.6445329 | 1.0000000 |
| right.feedback,X4 - wrong.feedback,X6 | -4.8975932 | 11.590240 | 91.22487 | -0.4225619 | 1.0000000 |
| wrong.feedback,X4 - normal,X5 | 44.0620372 | 11.590240 | 91.22487 | 3.8016503 | 0.0093359 |
| wrong.feedback,X4 - right.feedback,X5 | 3.5939789 | 11.590240 | 91.22487 | 0.3100867 | 1.0000000 |
| wrong.feedback,X4 - wrong.feedback,X5 | 17.8782641 | 8.775322 | 94.42476 | 2.0373342 | 1.0000000 |
| wrong.feedback,X4 - normal,X6 | 50.6408815 | 11.590240 | 91.22487 | 4.3692696 | 0.0011854 |
| wrong.feedback,X4 - right.feedback,X6 | 9.9576861 | 11.590240 | 91.22487 | 0.8591441 | 1.0000000 |
| wrong.feedback,X4 - wrong.feedback,X6 | 10.7160767 | 8.775322 | 94.42476 | 1.2211605 | 1.0000000 |
| normal,X5 - right.feedback,X5 | -40.4680584 | 10.466187 | 73.65424 | -3.8665522 | 0.0084942 |
| normal,X5 - wrong.feedback,X5 | -26.1837732 | 10.466187 | 73.65424 | -2.5017490 | 0.5248471 |
| normal,X5 - normal,X6 | 6.5788443 | 8.775322 | 94.42476 | 0.7496983 | 1.0000000 |
| normal,X5 - right.feedback,X6 | -34.1043511 | 11.590240 | 91.22487 | -2.9425061 | 0.1485895 |
| normal,X5 - wrong.feedback,X6 | -33.3459605 | 11.590240 | 91.22487 | -2.8770726 | 0.1799157 |
| right.feedback,X5 - wrong.feedback,X5 | 14.2842852 | 10.466187 | 73.65424 | 1.3648032 | 1.0000000 |
| right.feedback,X5 - normal,X6 | 47.0469027 | 11.590240 | 91.22487 | 4.0591829 | 0.0037389 |
| right.feedback,X5 - right.feedback,X6 | 6.3637072 | 8.775322 | 94.42476 | 0.7251822 | 1.0000000 |
| right.feedback,X5 - wrong.feedback,X6 | 7.1220979 | 11.590240 | 91.22487 | 0.6144910 | 1.0000000 |
| wrong.feedback,X5 - normal,X6 | 32.7626175 | 11.590240 | 91.22487 | 2.8267420 | 0.2080236 |
| wrong.feedback,X5 - right.feedback,X6 | -7.9205780 | 11.590240 | 91.22487 | -0.6833835 | 1.0000000 |
| wrong.feedback,X5 - wrong.feedback,X6 | -7.1621873 | 8.775322 | 94.42476 | -0.8161737 | 1.0000000 |
| normal,X6 - right.feedback,X6 | -40.6831954 | 10.466187 | 73.65424 | -3.8871077 | 0.0079195 |
| normal,X6 - wrong.feedback,X6 | -39.9248048 | 10.466187 | 73.65424 | -3.8146466 | 0.0101284 |
| right.feedback,X6 - wrong.feedback,X6 | 0.7583906 | 10.466187 | 73.65424 | 0.0724610 | 1.0000000 |
2.3.2.2.2 Aggregated By Median
mod <- aov_car(rt ~ feed.f + Error(vp/feed.f),data=inhib_crit_we,fun_aggregate = median)
knitr::kable(nice(mod))| Effect | df | MSE | F | ges | p.value |
|---|---|---|---|---|---|
| feed.f | 1.51, 28.76 | 1058.56 | 11.02 *** | .11 | .0007 |
summary(mod)##
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
##
## SS num Df Error SS den Df F Pr(>F)
## (Intercept) 20611186 1 115524 19 3389.890 < 2.2e-16 ***
## feed.f 17649 2 30441 38 11.015 0.0001686 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Mauchly Tests for Sphericity
##
## Test statistic p-value
## feed.f 0.67858 0.030509
##
##
## Greenhouse-Geisser and Huynh-Feldt Corrections
## for Departure from Sphericity
##
## GG eps Pr(>F[GG])
## feed.f 0.75676 0.0007418 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## HF eps Pr(>F[HF])
## feed.f 0.8083537 0.0005410575# get the least square means
referenceGrid <- emmeans(mod, ~ feed.f)
# pairwise comparisons
summary(pairs(referenceGrid, adjust="bonferroni")) %>% knitr::kable(.)| contrast | estimate | SE | df | t.ratio | p.value |
|---|---|---|---|---|---|
| normal - right.feedback | -34.329305 | 8.950321 | 38 | -3.8355389 | 0.0013756 |
| normal - wrong.feedback | -38.135200 | 8.950321 | 38 | -4.2607633 | 0.0003879 |
| right.feedback - wrong.feedback | -3.805895 | 8.950321 | 38 | -0.4252244 | 1.0000000 |
# With Block as Factor
mod <- aov_car(rt ~ feed.f + block.f + Error(vp/feed.f+block.f),data=inhib_crit_we,fun_aggregate = median)
knitr::kable(nice(mod))| Effect | df | MSE | F | ges | p.value |
|---|---|---|---|---|---|
| feed.f | 1.37, 25.94 | 3108.68 | 13.02 *** | .10 | .0005 |
| block.f | 1.82, 34.64 | 1167.14 | 0.75 | .003 | .47 |
| feed.f:block.f | 2.46, 46.74 | 803.97 | 2.59 + | .010 | .07 |
2.3.2.3 Plots
id <- inhib_crit_we %>% group_by(.,feed.f) %>%
dplyr::summarize(., mean = mean(rt),
se = sd(rt)/sqrt(length(rt)))
a <- inhib_crit_we %>% group_by(.,feed.f,vp) %>%
dplyr::summarize(., mean = mean(rt),
se = sd(rt)/sqrt(length(rt)))
pd <- position_dodge(0.4)
ggplot(id, aes(x=feed.f, y=mean, fill=feed.f)) +
geom_bar(position=position_dodge(), stat="identity") +
#scale_fill_manual(values=c("grey80","grey70","grey60")) +
scale_y_continuous(expand=c(0,0), limits = c(0, 800) ) +
geom_errorbar(aes(ymin=mean-se, ymax=mean+se), width=.2, position=position_dodge(.9)) +
geom_line(data=a, aes(x=feed.f, y=mean, group=vp),alpha = .3,lineend = "round",position = pd) +
geom_point(data=a, aes(x=feed.f, y=mean,group=vp),shape = 21, alpha = .3,position = pd) +
theme_bw() + theme(legend.position="none") +
labs(
#title = "Hitrate",
x = "Feedback type",
y = "RT (ms)",
color = NULL
)
ggplot(id, aes(x=feed.f, y=mean,group=1)) +
geom_smooth(method="loess") +
geom_point() +
scale_y_continuous(expand=c(0,0), limits = c(500,650) ) +
geom_errorbar(aes(ymin=mean-se, ymax=mean+se), width=.2) +
theme_bw() + theme(legend.position="none") +
labs(
#title = "Hitrate",
x = "Feedback type",
y = "RT (ms)",
color = NULL
)
ggplot(id, aes(x=feed.f, y=mean,group=1)) +
geom_smooth(method="loess") +
geom_point() +
scale_y_continuous(expand=c(0,0), limits = c(480, 720) ) +
geom_errorbar(aes(ymin=mean-se, ymax=mean+se), width=.2, height = .2, position=position_dodge(.9)) +
geom_line(data=a, aes(x=feed.f, y=mean, group=vp),alpha = .3,lineend = "round",position = pd) +
geom_point(data=a, aes(x=feed.f, y=mean,group=vp),shape = 21, alpha = .3,position = pd) +
theme_bw() + theme(legend.position="none") +
labs(
#title = "Hitrate",
x = "Feedback type",
y = "RT (ms)",
color = NULL
)
ggsave("plotResults.png",dpi=900,width=12,height=6, units = "cm",bg = "transparent")
id <- inhib_crit_we %>% group_by(.,feed.f,block.f) %>%
dplyr::summarize(., mean = mean(rt),
se = sd(rt)/sqrt(length(rt)))
a <- inhib_crit_we %>% group_by(.,feed.f,vp,block.f) %>%
dplyr::summarize(., mean = mean(rt),
se = sd(rt)/sqrt(length(rt)))
levels(id$feed.f) <- c("normal","right","wrong")
levels(id$block.f) <- c("Block 1","Block 2","Block 3","Block 4","Block 5","Block 6")
levels(a$feed.f) <- c("normal","right","wrong")
levels(a$block.f) <- c("Block 1","Block 2","Block 3","Block 4","Block 5","Block 6")
ggplot(id, aes(x=feed.f, y=mean,group=1)) +
geom_smooth(method="loess") +
geom_point() +
scale_y_continuous(expand=c(0,0), limits = c(480, 720) ) +
geom_errorbar(aes(ymin=mean-se, ymax=mean+se), width=.2, height = .2, position=position_dodge(.9)) +
geom_line(data=a, aes(x=feed.f, y=mean, group=vp),alpha = .3,lineend = "round",position = pd) +
geom_point(data=a, aes(x=feed.f, y=mean,group=vp),shape = 21, alpha = .3,position = pd) +
theme_bw() + theme(legend.position="none") +
labs(
#title = "Hitrate",
x = "Feedback type",
y = "RT (ms)",
color = NULL
) +
facet_grid(.~block.f)
ggsave("plotResultsInteraktion.png",dpi=900,width=15,height=6, units = "cm",bg = "transparent")ANOVA only for block 4
block4 <- filter(inhib_crit_we, block==4)
mod <- aov_car(rt ~ feed.f + Error(vp/feed.f),data=block4,fun_aggregate = mean)
knitr::kable(nice(mod))| Effect | df | MSE | F | ges | p.value |
|---|---|---|---|---|---|
| feed.f | 1.44, 27.28 | 1537.01 | 9.37 ** | .09 | .002 |
summary(mod)##
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
##
## SS num Df Error SS den Df F Pr(>F)
## (Intercept) 21410672 1 159420 19 2551.7653 < 2.2e-16 ***
## feed.f 20675 2 41926 38 9.3696 0.0004922 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Mauchly Tests for Sphericity
##
## Test statistic p-value
## feed.f 0.60691 0.011172
##
##
## Greenhouse-Geisser and Huynh-Feldt Corrections
## for Departure from Sphericity
##
## GG eps Pr(>F[GG])
## feed.f 0.71783 0.002084 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## HF eps Pr(>F[HF])
## feed.f 0.7604374 0.00167369# get the least square means
referenceGrid <- emmeans(mod, ~ feed.f)
block4_r_w <- filter(block4 , feed.f=="wrong feedback" | feed.f=="right feedback")
aggr_data <- block4_r_w %>% group_by(.,vp,feed.f) %>% summarize(mRT=mean(rt))
leveneTest(mRT ~ feed.f,data=aggr_data)t.test(mRT ~ feed.f,data=aggr_data,paired=TRUE,equal.var=TRUE,alternative ="less")##
## Paired t-test
##
## data: mRT by feed.f
## t = -1.8937, df = 19, p-value = 0.0368
## alternative hypothesis: true difference in means is less than 0
## 95 percent confidence interval:
## -Inf -1.357017
## sample estimates:
## mean of the differences
## -15.61367library(effsize)
wr <- filter(aggr_data,feed.f=="wrong feedback")
rg <- filter(aggr_data,feed.f=="right feedback")
cohen.d(rg$mRT,wr$mRT,data=aggr_data,paired=TRUE)##
## Cohen's d
##
## d estimate: -0.4234487 (small)
## 95 percent confidence interval:
## inf sup
## -1.0707528 0.2238555data <- block4 %>% dplyr::select(.,vp,rt,feed.f) %>% group_by(feed.f,vp) %>% summarize(., mRT=mean(rt)) %>% spread(feed.f,mRT) %>% write.csv2(file="KogSemJasp.csv",.)3 Explorations
3.1 Logistic regression on errors
block4 <- filter(inhib_crit, block==4)
tab <- table(inhib_crit$fehl,inhib_crit$feed.f)
tab##
## normal right feedback wrong feedback
## 0 2315 576 571
## 1 87 24 22tab[2,]/tab[1,]## normal right feedback wrong feedback
## 0.03758099 0.04166667 0.03852890logmod_error <- glmer(fehl ~ feed.f + (feed.f|vp),data=block4,family=binomial)
summary(logmod_error)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: fehl ~ feed.f + (feed.f | vp)
## Data: block4
##
## AIC BIC logLik deviance df.resid
## 330.3 376.1 -156.1 312.3 1191
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -0.5653 -0.1751 -0.1349 -0.1077 7.4144
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## vp (Intercept) 0.78892 0.8882
## feed.fright feedback 1.35368 1.1635 1.00
## feed.fwrong feedback 0.02697 0.1642 -1.00 -1.00
## Number of obs: 1200, groups: vp, 20
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.9298 0.3736 -10.520 <2e-16 ***
## feed.fright feedback -0.8103 1.1792 -0.687 0.492
## feed.fwrong feedback 0.3855 0.5891 0.654 0.513
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) fd.frf
## fd.frghtfdb -0.084
## fd.fwrngfdb -0.451 0.081
## convergence code: 0
## Model failed to converge with max|grad| = 0.00687127 (tol = 0.001, component 1)3.2 EZ-Diffusion model
get.vaTer <- function(Pc,VRT,MRT,s=0.1){
s2=s^2 # default value of the scaling paramter == 0.1
if(Pc==0)
cat("Error PC == 0 !\n")
if(Pc==0.5)
cat("Error PC == 0.5 !\n")
if(Pc==1)
cat("Error PC == 1 !\n")
L = qlogis(Pc) # calculate logit
x = L*(L*Pc^2 - L*Pc + Pc - .5)/VRT
v = sign(Pc-.5)*s*x^(1/4) # drift rate
a = s2*L/v # boundary spereation
y = -v*a/s2
MDT = (a/(2*v))*(1-exp(y))/(1+exp(y))
Ter = MRT - MDT # non decision time
return(list("drift rate= "= v,
"boundary spereration = " = a,
"non decision time = " = Ter))
}
inhib_crit %>% group_by(feed.f) %>% summarize( ., trials = length(res),
errors=sum(fehl==1),
errorrate = errors/trials,
Pc = sum(fehl==0)/trials,
check = errorrate + Pc,
MRT = mean(rt)/1000,
VRT = var(rt)/(1000^2))# right
get.vaTer(Pc=0.960,VRT=0.0189,MRT=0.592,s=0.1)## $`drift rate= `
## [1] 0.274563
##
## $`boundary spereration = `
## [1] 0.1157495
##
## $`non decision time = `
## [1] 0.3980745# wrong
get.vaTer(Pc=0.963,VRT=0.0165,MRT=0.598,s=0.1)## $`drift rate= `
## [1] 0.287705
##
## $`boundary spereration = `
## [1] 0.1132804
##
## $`non decision time = `
## [1] 0.4156992# normal
get.vaTer(Pc=0.964,VRT=0.0173,MRT=0.559,s=0.1)## $`drift rate= `
## [1] 0.285559
##
## $`boundary spereration = `
## [1] 0.1151276
##
## $`non decision time = `
## [1] 0.3719311temp <- inhib_crit %>% group_by(feed.f,vp) %>% summarize( ., trials = length(res),
errors=sum(fehl==1),
errorrate = errors/trials,
Pc = sum(fehl==0)/trials,
check = errorrate + Pc,
MRT = mean(rt,na.rm=TRUE)/1000,
VRT = var(rt)/(1000^2))
ez <- get.vaTer(Pc=temp$Pc,VRT=temp$VRT,MRT=temp$MRT,s=0.1)
m_v <- lm(unlist(ez[1]) ~ temp$feed.f)
summary(m_v)##
## Call:
## lm(formula = unlist(ez[1]) ~ temp$feed.f)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.17058 -0.04847 -0.01494 0.05277 0.15310
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.30872 0.01962 15.736 4.87e-16 ***
## temp$feed.fright feedback -0.10008 0.03398 -2.945 0.00618 **
## temp$feed.fwrong feedback -0.08029 0.03270 -2.455 0.02008 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.07848 on 30 degrees of freedom
## (27 observations deleted due to missingness)
## Multiple R-squared: 0.2686, Adjusted R-squared: 0.2198
## F-statistic: 5.507 on 2 and 30 DF, p-value: 0.009178